MacWorld 1999 September (IDG)/Sep99.iso/Shareware World/Utilities/Text Processing/Alpha/Tcl/SystemCode/indentation.tcl

Text File | 1999-04-21 | 17.1 KB | 594 lines | [TEXT/ALFA]

## -*-Tcl-*-
 # ###################################################################
 #    Vince's    Additions -    an extension package for Alpha
 #
 #    FILE: "indentation.tcl"
 #                      created: 27/7/97 {1:08:08 am}
 #                     last update: 21/4/1999 {2:48:18 pm}
 #    Author:    Vince Darley
 #    E-mail:    <[e-mail]>
 #      mail:    Division of Applied Sciences, Harvard University
 #            Oxford Street, Cambridge MA 02138, USA
 #       www:    <http://www.fas.harvard.edu/~darley/>
 #
 # ###################################################################
 ##

alpha::flag electricBraces 0.1 {global C C++ Java Tcl Perl} help {
    Enabling the 'Electric Braces' feature tells Alpha to treat the
    left or right brace '{', '}' keys as special keypresses which
    enter the '{' or '}' character, followed by a return and then
    indent the following line correctly.  It is useful for those
    programming modes in which '{' and '}' are used to delineate
    blocks of code in 'for' loops or 'if-then-else' groups etc.
}

alpha::flag electricSemicolon 0.1 {global C C++ Java Perl} help {
    Enabling the 'Electric Semicolon' feature tells Alpha to treat the
    semicolon key ';' as special keypresses which enters the ';'
    character followed by a return and then indents the following line
    correctly.  It is useful for some programming modes in which ';'
    normally ends a line.

    The ';' key is context-dependent so you can still enter a
    for( ; ; ) loop in C mode (for instace) without Alpha messing
    things up.
}

alpha::feature electricReturn 0.1 {global} {
    if {[info tclversion] >= 8.0} {
    linkVar indentOnReturn
    }
    set indentOnReturn 0
} {set indentOnReturn 1} {set indentOnReturn 0} help {
    Enabling the 'Electric Return' feature tells Alpha to indent the
    following line automatically whenever you press return.
}

alpha::flag electricColon 0.1 {global} help {
    Enabling the 'Electric Colon' feature tells Alpha to carry out a
    special action when the user presses colon.
}

alpha::flag autoContinueComment 0.1 {global} help {
    Enabling the 'autoContinueComment' feature tells Alpha to check when
    the users hits return whether the current line is a comment, and if
    so, to indent and insert comment characters so that the following
    line continues the comment.
}

alpha::flag indentUsingSpacesOnly 0.1 {global TeX} help {
    If set, do not use tabs to indent, but spaces only.  This is mostly
    useful for modes in which the 'tab' character has a special meaning,
    such as python or TeX (the latter usually only for TeX as a programming
    language, not as a document preparation system).
}

alpha::flag commentsArentSpecialWhenIndenting 0.1 {global TeX} help {
    Indent lines to level of previous line if set, otherwise to level
    of previous non-comment line (in which case Alpha will search
    backwards for some distance).  If you're in the habit of indenting
    your comments to the same level as your code, this setting
    shouldn't matter (and setting it is slightly more efficient).

    One case in which it can be _much_ more efficient is when your
    files contain vast comments (especially .dtx files in TeX mode,
    for instance).  For these files, you should activate this feature.
}

namespace eval indent {}
namespace eval Bind {}
namespace eval text {}

proc IndentLine {} { bind::IndentLine }

proc typeText {t} {
    if {[isSelection]} {
    deleteSelection
    }
    insertText $t
}

proc normalLeftBrace {} {
    typeText "\{"
}
proc normalRightBrace {} {
    typeText "\}"
    blink [matchIt "\}" [pos::math [getPos] - 2]]
}

proc literalChar {} {
    return [expr {[lookAt [pos::math [getPos] - 1]] == "\\"}]
}

# ◊◊◊◊ Electric indentation ◊◊◊◊ #
proc bind::LeftBrace {} {
    if {[isSelection]} { deleteSelection }
    global electricBraces mode
    if {!$electricBraces} {
    insertText "\{"
    return
    }
    mode::proc electricLeft
}

proc ::electricLeft {} {
    if {![catch {search -l [lineStart [pos::math [lineStart [getPos]] - 1]] \
      -s -f 0 -r 0 "\}" [getPos]} res]} {
    set end [getPos]
    if {[pos::compare [getPos] != [maxPos]]} {
        set end [pos::math $end + 1]
    }

    if {[regexp -- "\}\[ \t\r\n\]*else" [getText [lindex $res 0] $end]]} {
        set res2 [search -s -f 0 -r 1 {else} [getPos]]
        oneSpace
        set text [getText [lindex $res2 0] [getPos]]
        if {[lookAt [pos::math [getPos] - 1]] != " "} {
        append text " "
        }
        replaceText [pos::math [lindex $res 0] + 1] [getPos] " $text\{\r"
        bind::IndentLine
        return
    }
    }
    set pos [getPos]
    set i [text::firstNonWsLinePos $pos]

    if {([pos::compare $i == $pos]) || ([lookAt [pos::math $pos - 1]] == " ")} {
    insertText "\{\r" [text::indentString $pos] [text::Tab]
    } else {
    insertText " \{\r" [text::indentString $pos] [text::Tab]
    }
}

proc ::electricRight {} {
    set pos [getPos]
    set start [lineStart $pos]

    if {[catch {matchIt "\}" [pos::math $pos - 1]} matched]} {
    beep
    message "No matching '\{'!"
    return
    }
    set text [getText [lineStart $matched] $matched]
    regexp "^\[ \t\]*" $text indentation
    if {[string trim [getText $start $pos]] != ""} {
    insertText "\r" $indentation "\}\r" $indentation
    blink $matched
    return
    }
    set text "${indentation}\}\r$indentation"
    replaceText $start $pos $text
    goto [pos::math $start + [string length $text]]
    blink [matchIt "\}" [pos::math $start - 2]]
}

proc bind::RightBrace {} {
    if {[isSelection]} { deleteSelection }
    global electricBraces mode
    if {!$electricBraces} {
    insertText "\}"
    catch {blink [matchIt "\}" [pos::math [getPos] - 2]]}
    return
    }
    mode::proc electricRight
}

proc bind::electricSemi {} {
    if {[isSelection]} { deleteSelection }
    global electricSemicolon mode
    if {!$electricSemicolon} {
    insertText ";"
    return
    }
    mode::proc electricSemi
}

proc ::electricSemi {} {
    set pos [getPos]
    set start [lineStart $pos]
    set text [getText $start $pos]

    if {[string first "for" $text] != "-1"} {
    set paren 0
    set len [string length $text]
    for {set i 0} {$i < $len} {incr i} {
        switch -- [string index $text $i] {
        "("    { incr paren }
        ")"    { incr paren -1 }
        }
    }
    if {$paren != 0} {
        insertText ";"
        return
    }
    }

    insertText ";\r" [text::indentString $pos]
}

##
 # -------------------------------------------------------------------------
 #
 # "bind::CarriageReturn" --
 #
 #    General    purpose    CR procedure.  Should be bound to 'return' for all
 #    modes really.  Calls a mode-specific procedure if required.
 # -------------------------------------------------------------------------
 ##
proc bind::CarriageReturn {} {
    if {[isSelection]} { deleteSelection }
    global autoContinueComment
    if {$autoContinueComment && ([text::isInComment [set p [getPos]] start])} {
    # special case for beginning of line
    if {[pos::compare $p == [lineStart $p]]} {
        backwardChar
    }
    insertText "\r${start}"
    return
    }
    mode::proc carriageReturn
}

proc ::carriageReturn {} {
    insertText "\r"
    global indentOnReturn
    if {$indentOnReturn} {bind::IndentLine}
}

proc bind::IndentLine {} {
    mode::proc indentLine
}

proc insertActualTab {} { typeText "\t" }



##
 # -------------------------------------------------------------------------
 #
 # "text::isInComment" --
 #
 # Are we in a block comment? Just checks if both the given line and the
 # next line commence with any of a set of known block-comment characters.
 # Not 100% satisfactory for C comments, but fine for all others.
 # -------------------------------------------------------------------------
 ##
proc text::isInComment {pos {st ""}} {
    if {[pos::compare $pos == [minPos]]} {
    return 0
    }
    set p [lineStart $pos]
    if {[pos::compare $pos == $p]} {
    set pos [pos::math $pos - 1] ; set p [lineStart $pos]
    }
    set q [nextLineStart $pos]
    set t [getText $p $q]
    if { $st != "" } {
    upvar $st a
    }
    if {![catch {commentCharacters "Paragraph"} cpar]} {
    if {[regexp -- "^\[ \t\]*[quote::Regfind [lindex $cpar 0]]" $t a]} {
        if {![regexp -- "[quote::Regfind [lindex $cpar 1]]" $t]} {
        set len [string length [lindex $cpar 2]]
        set a [string range $a 0 [expr {[string length $a] - $len -1}]]
        append a [lindex $cpar 2]
        return 1
        }
    }
    }
    # if the next line is a comment
    set qq [text::firstNonWsLinePos $q]
    if {[pos::compare $qq == [maxPos]]} {
    return 0
    }
    foreach commentCh [commentCharacters "General"] {
    if {[regexp -- "^\[ \t\]*[quote::Regfind ${commentCh}]\[ \t\]*" $t a]} {
        # if we hit return in the middle of a line
        if {[string trim [getText $pos $q]] != "" && [pos::compare $pos != $p]} {
        return 1
        }
        if {[getText $qq [pos::math $qq + [string length $commentCh]]] == $commentCh} {
        return 1
        }
    }
    }
    return 0
}


# ◊◊◊◊ Indentation utility routines ◊◊◊◊ #

proc posX {pos} {return [lindex [posToRowCol $pos] 1] }
# the above version doesn't work!
if {[info tclversion] < 8.0} {
proc posX {pos} {return [string length [text::maxSpaceForm [getText [lineStart $pos] $pos]]]}
}

proc text::firstNonWs {pos} {
    set p [text::firstNonWsPos $pos]
    if {[pos::compare $p > [minPos]]} {
    return [lookAt $p]
    } else {
    return ""
    }
}

##
 # -------------------------------------------------------------------------
 #
 # "text::firstNonWsPos" --
 #
 #  This returns the position of the first non-whitespace character from
 #  the start of pos' line.  It need not return something on the same
 #  line.
 # -------------------------------------------------------------------------
 ##
proc text::firstNonWsPos {pos} {
    if {[catch {lindex [search -s -f 1 -r 1 "\[^ \t\r\n\]" [lineStart $pos]] 0} res]} {
    return [lineStart $pos]
    } else {
    return $res
    }
}

proc text::firstNonWsLinePos {pos} {
    if {[catch {lindex [search -s -f 1 -r 1 "\[^ \t\]" [lineStart $pos]] 0} res]} {
    return [lineStart $pos]
    } else {
    return $res
    }
}

proc text::indentation {pos} {
    return [search -s -m 0 -f 1 -r 1 "^\[ \t\]*\[^ \t\]" [lineStart $pos]]
}

##
 # -------------------------------------------------------------------------
 #
 # "text::minSpaceForm" --
 #
 #  Converts to minimal form: tabs then spaces.  Uses one regsub to do
 #  the job.  Note that the regexp used relies upon the left-to-right
 #  priority of branch matching.  If the regexp library used is more
 #  sophisticated and finds maximal matches, then this is no good.
 #  In that case use:
 #        regsub -all $sp $ws "\t" ws
 #        regsub -all " +\t" $ws "\t" ws
 # -------------------------------------------------------------------------
 ##
if {[info tclversion] < 8.1} {
    proc text::minSpaceForm {ws} {
    regsub -all "([spacesEqualTab]| +\t)" $ws "\t" ws
    return $ws
    }
} else {
    proc text::minSpaceForm {ws} {
    regsub -all [spacesEqualTab] $ws "\t" ws
    regsub -all " +\t" $ws "\t" ws
    return $ws
    }
}


##
 # -------------------------------------------------------------------------
 #
 # "text::maxSpaceForm" --
 #
 #  Converts it to maximal form - just spaces.
 #  Just uses one funky regsub to do the job!  Takes account of tab-size,
 #  spaces interspersed with tabs,...
 # -------------------------------------------------------------------------
 ##
if {[info tclversion] < 8.1} {
    proc text::maxSpaceForm {ws} {
    set sp [spacesEqualTab]
    regsub -all "(($sp)*) *\t" $ws "\\1$sp" ws
    return $ws
    }
} else {
    proc text::maxSpaceForm {ws} {
    set sp [spacesEqualTab]
    regsub -all $sp $ws "\t" ws
    regsub -all " +\t" $ws "\t" ws
    regsub -all "\t" $ws "$sp" ws
    return $ws
    }
}


##
 # -------------------------------------------------------------------------
 #
 # "spacesEqualTab" --
 #
 #  Return the number of spaces equivalent to a single tab. If tabs are too
 #  big, this won't work.
 # -------------------------------------------------------------------------
 ##
proc spacesEqualTab {} {
    getWinInfo a
    string range "              " 1 $a(tabsize)
}

proc doubleLookAt {pos} {return [getText $pos [pos::math $pos + 2]]}

set bind::_IndentSpaces "                                                   \
                                         "
set bind::_IndentTabs "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t"

proc text::indentOf {size} {
    global bind::_IndentSpaces bind::_IndentTabs indentUsingSpacesOnly
    if {$indentUsingSpacesOnly} {
    return [string range ${bind::_IndentSpaces} 1 $size]
    } else {
    getWinInfo a
    set ret [string range ${bind::_IndentTabs} 1 [expr $size / $a(tabsize)]]
    append ret [string range ${bind::_IndentSpaces} 1 [expr $size % $a(tabsize)]]
    }
    return $ret
}

# returns the indent string of the line named by 'pos'
proc text::indentString {pos} {
    set beg [lineStart $pos]
    regexp "^\[ \t\]*" [getText $beg [nextLineStart $beg]] white
    return $white
}

# returns the indent string of the line up to position 'pos'
proc text::indentTo {pos} {
    regexp "^\[ \t\]*" [getText [lineStart $pos] $pos] white
    return $white
}

##
 # -------------------------------------------------------------------------
 #
 # "text::indentBy" --
 #
 #  Take the given block of text, and insert/remove spaces and tabs to
 #  indent it $by spaces to the left or right. This version should work
 #  ok for Tcl 7.5/8.0/8.1
 # -------------------------------------------------------------------------
 ##
proc text::indentBy {text by} {
    global bind::_IndentSpaces indentUsingSpacesOnly
    set sp [spacesEqualTab]
    # Convert all leading whitespace to spaces
    while {[regsub -all "((^|\r|\n)($sp)*) *\t" $text "\\1$sp" text]} {}
    set sby [string range ${bind::_IndentSpaces} 1 [expr {abs($by)}]]
    if {$by < 0} {
    # need to indent less
    regsub -all "(^|\r|\n)$sby" $text "\\1" text
    } else {
    # need to indent more: add spaces to beginning of each line,
    # apart from blank lines and the final line
    regsub -all "\[\r\n\](\[^\r\n\])" $sby$text "\r$sby\\1" text
    }
    # We already converted everything to spaces, so we only convert
    # to tabs if the user wants them.
    if {!$indentUsingSpacesOnly} {
    while {[regsub -all "((^|\r|\n)\t*)$sp" $text "\\1\t" text]} {}
    }
    return $text
}

proc text::halfTab {} {
    global indent_amounts
    return [string range "              " 1 $indent_amounts(1)]
}
proc text::Tab {} {
    global indentationAmount
    return [text::indentOf $indentationAmount]
}

proc text::getTabSize {} {
    getWinInfo a
    return $a(tabsize)
}

# ◊◊◊◊ General purpose indentation ◊◊◊◊ #

proc indentSelection {} {
    mode::proc indentRegion
}

##
 # -------------------------------------------------------------------------
 #
 # "text::inCommentBlock" --
 #
 #  Returns 'startpos endpos' if true, else returns an error.  Not
 #  particularly robust, but not too bad either
 # -------------------------------------------------------------------------
 ##
proc text::inCommentBlock {pos} {
    set chars [commentCharacters Paragraph]
    set start [string trim [lindex $chars 0]]
    set end [string trim [lindex $chars 1]]
    if {$start == $end} {
    error "No"
    }
    set cS [search -s -f 0 -r 0 -l [pos::math $pos - 1000] $start $pos]
    set cE [search -s -f 1 -r 0 -l [pos::math $pos + 1000] $end [lindex $cS 1]]
    if {[pos::compare $pos >= [lindex $cE 1]]} {
    error "No"
    } else {
    return [list [lindex $cS 0] [lindex $cE 1]]
    }
}


# Tom's new regexp which I don't use now.  Shame.
#set commentRegexp       {/\*[^*]*\*+([^/*][^*]*\*+)*/}

#########################################################################
# Generic C-style indentation (works for Tcl and Perl)
# Significant changes by Vince.
proc ::indentLine {} {
    global commentsArentSpecialWhenIndenting
    # get details of current line
    set beg [lineStart [getPos]]
    set text [getText $beg [nextLineStart $beg]]
    regexp "^\[ \t\]*" $text white
    set len [string length $white]
    set epos [pos::math $beg + $len]

    if {[pos::compare $beg != [minPos]]} {
    # Find last previous non-comment line and get its leading whitespace
    set pos $beg
    while 1 {
        if {[pos::compare $pos == [minPos]] || [catch {search -s -f 0 -r 1 -i 0 -m 0 "^\[ \t\]*\[^ \t\r\n\]" [pos::math $pos - 1]} lst]} {
        # search failed at top of file
        set line "#"
        set lwhite 0
        break
        }
        if {!$commentsArentSpecialWhenIndenting && \
          ![catch {text::inCommentBlock [lindex $lst 0]} res]} {
        set pos [lindex $res 0]
        } else {
        set line [getText [lindex $lst 0] [pos::math [nextLineStart [lindex $lst 0]] - 1]]
        set lwhite [posX [pos::math [lindex $lst 1] - 1]]
        break
        }
    }

    regexp "(\[^ \t\])\[ \t\]*\$" $line "" nextC
    global indentationAmount electricColon
    if {($nextC == "\{")} {
        incr lwhite $indentationAmount
    } elseif {$nextC == ":" && $electricColon} {
        incr lwhite [expr {$indentationAmount /2}]
    }

    if {[regexp ":\[ \t\r\n\]*\$" $text] && $electricColon} {incr lwhite [expr {-$indentationAmount / 2}]}
    if {[lookAt $epos] == "\}"} {
        incr lwhite [expr {-$indentationAmount}]
    }
    } else {
    set lwhite 0
    }
    set lwhite [text::indentOf $lwhite]
    if {$white != $lwhite} {
    replaceText $beg $epos $lwhite
    }
    goto [pos::math $beg + [string length $lwhite]]
}


proc ::indentRegion {} {
    set from [lindex [posToRowCol [getPos]] 0]
    set to [lindex [posToRowCol [selEnd]] 0]
    select [getPos]
    while {$from <= $to} {
    goto [rowColToPos $from 0]
    bind::IndentLine
    incr from
    }
}